home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb40.zip / MAKEZAP.200 < prev    next >
Text File  |  1986-04-23  |  5KB  |  96 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*         M A K E _ Z A P :  A p p l y  S p e c i f i e d  Z a p     *}
  4. {*                                                                    *}
  5. {*             S e p a r a t e  O u t  I n t o  MakeZap.200           *}
  6. {**********************************************************************}
  7.  
  8. {---- ---- ---- ---- ----- ---- ---- ---- ---- ----- ---- ---- ----- --}
  9. {        F i n d _ Z a p  : P o s i t i o n  t o  H e a d e r          }
  10. {--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --}
  11. Procedure Find_Zap(Header :ParmString; Var Return_Code :integer);
  12.    Var
  13.       TempHdr    : String[80];
  14.       TempString : String[80];
  15.  
  16.    Begin { Find_Zap }
  17.      Assign(Zap_File,Zap_Filename);                 { Find Correct Zap posn}
  18.      {$I-}Reset(Zap_File);{$I+}
  19.      Return_Code := IOresult;
  20.      If (Return_Code <> 0) then
  21.         Pause(Zap_Filename+' Error: '+Char(Return_Code));
  22.  
  23.      TempHdr := Header+' '+Version_Key[Version].Name; {Concatenate Version }
  24.      While (TempHdr[Length(TempHdr)] = ' ')           {Name to search string}
  25.         do                                            {and deblank from end}
  26.         TempHdr[0] := Pred(TempHdr[0]);               {Show search string  }
  27.                                                       {within delimiters   }
  28.      Write(' Searching for Header ');                 
  29.      NormVideo; Writeln(Chr(16),TempHdr,Chr(17)); LowVideo;
  30.      Return_Code := 1;
  31.  
  32.      x := wherex; y :=wherey;
  33.      Repeat                               { Until Keyword header found    }
  34.      Readln(Zap_file,TempString);         { Look For zap identifier       }
  35.      GotoXY(x,y);                         { Show the lines we're skipping.}
  36.      Write(Chr(16),TempString,Chr(17));
  37.      If Tempstring[0] > TempHdr[0] then   { Equilize string lengths for   }
  38.         Tempstring[0] := TempHdr[0] ;     { Filestring = Keyword compare  }
  39.      Until (TempString = TempHdr) or (Eof(Zap_File));
  40.  
  41.      If TempString = TempHdr then         { Set a return code for either  }
  42.         begin                             { Success or Failure and give   }
  43.         Return_Code := 0;                 { human some mortal indication  }
  44.         Writeln;Writeln(' Positioned to Zap');
  45.         end
  46.     else begin
  47.         Writeln;Pause(' Zap not found');
  48.         Return_Code := 1;
  49.         end
  50.    End { Find_Zap };
  51.  
  52.  
  53. {-------------------------------------------------------------------}
  54. {    M a i n   P r o c e d u r e                                    }
  55. {--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}
  56. { Open Zap file, Position to Header, read the data and apply the zap}
  57. { Data as follows:                                                  }
  58. { Character Header identifier                                       }
  59. { $address length $hex $hex $hex $hex $hex . . . . . . . . . . . .  }
  60. {           :                                                       }
  61. {           :                                                       }
  62. { $0   End of Zap for this identifier                               }
  63. {-------------------------------------------------------------------}
  64. Procedure Make_Zap (Zap_Index : Zaptypes; Var Return_Code :integer);
  65.  
  66.    Var
  67.       Zap_Address,
  68.       Zap_Length   :integer ;
  69.       Zap_Data     :array[1..80] of byte;
  70.       x,y          :integer;
  71.  
  72.    Begin { Make_Zap }
  73.  
  74.     Find_Zap(Zap_Headers[Zap_Index], Return_Code); { Search for the Header}
  75.     x:=WhereX; y:=WhereY;
  76.  
  77.     If ( Return_Code = 0 ) then            { When we find the Zap Keyword in }
  78.     Repeat { Until Address = 0 }           { Ascii zap file, fetch the zap   }
  79.        Read(Zap_File,Zap_Address);         { address and number of zap bytes }        { Get Zap address      }
  80.        x:=x Mod 20 +1; GotoXY(x,y);        { on the Line.                    }
  81.        Write(' Working...');               { While making the zap, keep the  }
  82.        If Zap_Address <> 0 then            { User content with a turtle title}
  83.           Begin
  84.           Read(Zap_File,Zap_Length);                { Read Zap byte count }
  85.           For I := 1 to Zap_Length Do               { Read the Zap Data   }
  86.                    Read(Zap_File, Zap_Data[I] );
  87.                    Readln(Zap_File);                { Skip any comments   }
  88.           Seek(ComOut_File,Zap_Address-$100);       { Seek to Zap Address}
  89.           For I := 1 to Zap_Length Do
  90.                    Write(ComOut_File,Zap_Data[I]);  { Write the Zap Data }
  91.           End { Zap_Address <> 0 }
  92.     Until (Zap_Address = 0);
  93.    Close(Zap_File); Writeln;
  94.    End; { Make_Zap }
  95.   {....................................................................}
  96.